{-  Copyright (C) 2014 Mark W Pearse  
  This program is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  This module is a layer above the raw imports in E_API which provides a 
  higher level, more Haskell-like interface. 
-}
module E_API where  

import E_Data
import E_rawAPI

import Control.Exception (bracket, bracket_)
import Foreign hiding (unsafePerformIO)
import Foreign.Ptr
import Foreign.C (CString(..), CString, newCString, withCString, castCharToCChar, castCCharToChar)
import Foreign.C.Types
import System.IO.Unsafe (unsafePerformIO)


data EpuPos = EpuPos {row :: Int, col :: Int}
    deriving (Show)

data GrpSize = GrpSize {rows :: Int, cols :: Int}
    deriving (Show)

-- These functions manage resources, ensuring that allocating/initializing is properly matched 
-- with freeing/finalizing them after the inner function that uses the resource has been called.

-- Epiphany data structures must be initialized before use
withEpiphany :: String -> IO a -> IO a
withEpiphany "" = bracket_ (e_init $ castPtr nullPtr) e_finalize -- use default HDF
withEpiphany hdf = bracket_ (withCString hdf e_init) e_finalize  -- specify path to the hdf file

-- Default setup of Epiphany, reset and access info in one neat package
withEpiphanyInfo :: (PlatformInfo -> IO a) -> IO a
withEpiphanyInfo body = withEpiphany "" $ do
    e_reset_system
    body platformInfo

-- Manage buffer in shared external memory
withBuffer :: Int -> Int -> (EmemRef -> IO a) -> IO a
withBuffer offset size = bracket before after
    where
        before = (do 
            ptr <- (malloc :: IO EmemRef)
            e_alloc ptr offset size
            return ptr)
        after = (\ptr -> do
            e_free ptr
            free ptr)

-- Manages allocating store for a Group, but does not open it
withGroupRef :: (GroupRef -> IO a) -> IO a
withGroupRef = bracket (malloc :: IO GroupRef) free 

-- Manages allocating and opening a Group
withGroup :: EpuPos -> GrpSize -> (GroupRef -> IO a) -> IO a
withGroup (EpuPos row col) (GrpSize rows cols) = bracket before after
    where
        before = (do 
            ptr <- (malloc :: IO GroupRef)
            e_open ptr row col rows cols
            return ptr)
        after = (\ptr -> do
            e_close ptr
            free ptr)

-- get information about this platform
platformInfo :: PlatformInfo
platformInfo = unsafePerformIO $
    alloca $ \ptr -> do
        res <- e_get_platform_info ptr
        pi <- peek ptr
        return pi


platformSize :: PlatformInfo -> GrpSize
platformSize pInfo = let rows = fixCInt $ p_rows pInfo
                         cols = fixCInt $ p_cols pInfo
                     in GrpSize rows cols

-- returns a list of EpuPos referring to all cores on the platform
allcores :: PlatformInfo -> [EpuPos]
allcores pi = [EpuPos row col | row <- [0..(fixCInt $ p_rows pi) - 1], col <- [0..(fixCInt $ p_cols pi) - 1]]

-- read from external memory
-- these functions wrap c functions that use c-strings so that ordinary Haskell strings can be used
ememRead :: Ptr Emem -> Int -> Int -> IO (Int, [CChar])
ememRead memref offset size = 
    allocaArray size $ \p -> do
        res <- e_mem_read memref 0 0 offset p size
        str <- peekArray size p
        return (res, str)

ememReadString :: Ptr Emem -> Int -> Int -> IO String
ememReadString memref offset size = do
    (count,cca) <- ememRead memref offset size
    return $ fixCString cca

ememReadInts :: Ptr Emem -> Int -> Int -> IO [Int]
ememReadInts memref offset size = do
    allocaArray size $ \p-> do
        res <- e_mem_read memref 0 0 offset (castPtr p) size
        arr <- peekArray size p
        return arr

ememWrite :: Ptr Emem -> Int -> [CChar] -> IO Int
ememWrite memref offset str = 
    let size = length str in
    allocaArray size $ \p -> do
        pokeArray p str
        res <- e_mem_write memref 0 0 offset p size
        return res

ememWriteInts :: Ptr Emem -> Int -> [Int] -> IO Int
ememWriteInts memref offset str = 
    let size = length str in
    allocaArray size $ \p -> do
        pokeArray p str
        res <- e_mem_write memref 0 0 offset (castPtr p) size
        return res

-- read from epiphany core
groupRead :: GroupRef -> EpuPos -> Int -> Int -> IO (Int, [CChar])
groupRead memref (EpuPos row col) offset size = 
    allocaArray size $ \p -> do
        res <- e_group_read memref row col offset p size
        str <- peekArray size p
        return (res, str)

groupReadInt :: GroupRef -> EpuPos -> Int -> IO Int
groupReadInt memref (EpuPos row col) offset = 
    alloca $ (\p -> do
        let intSize = sizeOf (0::Int)
        e_group_read memref row col offset (toCharPtr p) intSize
        int <- peek p
        return int)
{-
groupReadString :: GroupRef -> EpuPos -> Int -> Int -> IO String
groupReadString memref (EpuPos row col) offset size = do
    (count,cca) <- e_group_read memref row col offset size
    return $ fixCString cca

groupWrite :: GroupRef -> EpuPos -> Int -> [CChar] -> IO ()
groupWrite memref (EpuPos row col) offset str = 
    let size = length str in
    allocaArray size $ \p -> do
        pokeArray p str
        res <- e_group_write memref row col offset p size
        return
-}

eLoad :: String -> GroupRef -> EpuPos -> E_Bool -> IO Int
eLoad srec defptr (EpuPos row col) start = withCString srec (\p -> e_load p defptr row col start) 

eLoadGroup:: String -> GroupRef -> EpuPos -> GrpSize -> E_Bool -> IO Int
eLoadGroup srec defptr (EpuPos row col) (GrpSize rows cols) start = 
    withCString srec (\p -> e_load_group p defptr row col rows cols start) 
-- start: e_false=load only / e_true=load and run

-- functions to cast c-types into Haskell ones
fixCString :: [CChar] -> String
fixCString cca = map castCCharToChar $takeWhile (>0) cca

fixCInt :: CInt -> Int
fixCInt = fromIntegral

toCharPtr :: Ptr a-> Ptr CChar
toCharPtr = castPtr

-- Reads a value and tests it, looping until the test succeeds
spinLock :: (a -> Bool) -> IO a -> IO ()
spinLock test read = do
    x <- read
    case test x of
        True -> return ()
        False -> spinLock test read


mapSnd f (x , y) = (x , f y)
fixMess = mapSnd fixCString 

